home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
lisp
/
kcl
/
kcl.lha
/
cmpnew
/
cmpmulti.c
< prev
next >
Wrap
C/C++ Source or Header
|
1987-06-04
|
17KB
|
718 lines
/* (C) Copyright Taiichi Yuasa and Masami Hagiya, 1984. All rights reserved. */
#include <cmpinclude.h>
#include "cmpmulti.h"
init_cmpmulti(start,size,data)char *start;int size;object data;
{ register object *base=vs_top;register object *sup=base+VM2;vs_top=sup;vs_check;
Cstart=start;Csize=size;Cdata=data;set_VV(VV,VM1,data);
(void)(putprop(VV[0],VV[1],VV[2]));
(void)(putprop(VV[0],VV[3],VV[4]));
(void)(putprop(VV[5],VV[6],VV[2]));
(void)(putprop(VV[5],VV[7],VV[4]));
(void)(putprop(VV[8],VV[9],VV[10]));
(void)(putprop(VV[8],VV[11],VV[4]));
(void)(putprop(VV[12],VV[13],VV[10]));
(void)(putprop(VV[12],VV[14],VV[4]));
(void)(putprop(VV[15],VV[16],VV[10]));
(void)(putprop(VV[15],VV[17],VV[4]));
MF(VV[1],L11,start,size,data);
MF(VV[3],L12,start,size,data);
MF(VV[6],L13,start,size,data);
MF(VV[7],L14,start,size,data);
MF(VV[9],L15,start,size,data);
MF(VV[11],L16,start,size,data);
MF(VV[13],L17,start,size,data);
MF(VV[14],L18,start,size,data);
MF(VV[16],L19,start,size,data);
MF(VV[17],L20,start,size,data);
vs_top=vs_base=base;
}
/* function definition for C1MULTIPLE-VALUE-CALL */
static L11()
{ register object *base=vs_base;
register object *sup=base+VM3;
vs_reserve(VM3);
check_arg(1);
vs_top=sup;
TTL:;
base[1]= Cnil;
base[2]= Cnil;
if(!(endp(base[0]))){
goto T11;}
base[3]= VV[0];
base[4]= VV[18];
base[5]= VV[19];
(void)simple_symlispcall_no_event(VV[43],base+3,3);
T11:;
if(!(endp(cdr(base[0])))){
goto T18;}
base[3]= base[0];
symlispcall_no_event(VV[44],base+3,1);
return;
T18:;
base[3]= car(base[0]);
base[2]= simple_symlispcall_no_event(VV[45],base+3,1);
base[3]= cadr(base[2]);
base[1]= simple_symlispcall_no_event(VV[46],base+3,1);
base[3]= cdr(base[0]);
base[4]= base[1];
base[0]= simple_symlispcall_no_event(VV[47],base+3,2);
base[3]= list(4,VV[0],base[1],base[2],base[0]);
vs_top=(vs_base=base+3)+1;
return;
}
/* function definition for C2MULTIPLE-VALUE-CALL */
static L12()
{ register object *base=vs_base;
register object *sup=base+VM4;
vs_reserve(VM4);
bds_check;
check_arg(2);
vs_top=sup;
TTL:;
bds_bind(VV[20],symbol_value(VV[20]));
base[3]= Cnil;
base[4]= Cnil;
if(!(endp(cdr(base[1])))){
goto T32;}
base[5]= base[0];
base[3]= simple_symlispcall_no_event(VV[48],base+5,1);
bds_bind(VV[21],VV[22]);
base[6]= car(base[1]);
base[7]= simple_symlispcall_no_event(VV[49],base+6,1);
bds_unwind1;
base[5]= base[0];
base[6]= VV[23];
base[7]= base[3];
symlispcall_no_event(VV[50],base+5,3);
bds_unwind1;
return;
T32:;
setq(VV[24],number_plus(symbol_value(VV[24]),VV[18]));
base[4]= symbol_value(VV[24]);
base[5]= base[0];
base[3]= simple_symlispcall_no_event(VV[48],base+5,1);
princ_str("\n {object *V",VV[25]);
base[5]= base[4];
(void)simple_symlispcall_no_event(VV[51],base+5,1);
princ_str("=base+",VV[25]);
base[5]= (VV[20]->s.s_dbind);
(void)simple_symlispcall_no_event(VV[51],base+5,1);
princ_char(59,VV[25]);
setq(VV[26],Ct);
{object V1;
object V2;
V1= base[1];
V2= car((V1));
T62:;
if(!(endp((V1)))){
goto T63;}
goto T58;
T63:;
bds_bind(VV[21],VV[22]);
base[6]= (V2);
base[7]= base[4];
base[8]= simple_symlispcall_no_event(VV[52],base+6,2);
bds_unwind1;
princ_str("\n while(vs_base<vs_top)",VV[25]);
princ_str("\n {V",VV[25]);
base[5]= base[4];
(void)simple_symlispcall_no_event(VV[51],base+5,1);
princ_str("[0]=vs_base[0];V",VV[25]);
base[5]= base[4];
(void)simple_symlispcall_no_event(VV[51],base+5,1);
princ_str("++;vs_base++;}",VV[25]);
V1= cdr((V1));
V2= car((V1));
goto T62;}
T58:;
princ_str("\n vs_base=base+",VV[25]);
base[5]= (VV[20]->s.s_dbind);
(void)simple_symlispcall_no_event(VV[51],base+5,1);
princ_str(";vs_top=V",VV[25]);
base[5]= base[4];
(void)simple_symlispcall_no_event(VV[51],base+5,1);
princ_char(59,VV[25]);
setq(VV[26],Ct);
base[5]= base[0];
base[6]= VV[23];
base[7]= base[3];
(void)simple_symlispcall_no_event(VV[50],base+5,3);
princ_char(125,VV[25]);
base[5]= Cnil;
vs_top=(vs_base=base+5)+1;
bds_unwind1;
return;
}
/* function definition for C1MULTIPLE-VALUE-PROG1 */
static L13()
{ register object *base=vs_base;
register object *sup=base+VM5;
vs_reserve(VM5);
check_arg(1);
vs_top=sup;
TTL:;
base[1]= simple_symlispcall_no_event(VV[53],base+2,0);
base[2]= Cnil;
if(!(endp(base[0]))){
goto T101;}
base[3]= VV[5];
base[4]= VV[18];
base[5]= VV[19];
(void)simple_symlispcall_no_event(VV[43],base+3,3);
T101:;
base[3]= car(base[0]);
base[4]= base[1];
base[2]= simple_symlispcall_no_event(VV[54],base+3,2);
base[3]= cdr(base[0]);
base[4]= base[1];
base[0]= simple_symlispcall_no_event(VV[47],base+3,2);
base[3]= list(4,VV[5],base[1],base[2],base[0]);
vs_top=(vs_base=base+3)+1;
return;
}
/* function definition for C2MULTIPLE-VALUE-PROG1 */
static L14()
{ register object *base=vs_base;
register object *sup=base+VM6;
vs_reserve(VM6);
bds_check;
check_arg(2);
vs_top=sup;
TTL:;
setq(VV[24],number_plus(symbol_value(VV[24]),VV[18]));
base[2]= symbol_value(VV[24]);
setq(VV[24],number_plus(symbol_value(VV[24]),VV[18]));
base[3]= symbol_value(VV[24]);
bds_bind(VV[21],VV[22]);
base[5]= base[0];
base[6]= simple_symlispcall_no_event(VV[49],base+5,1);
bds_unwind1;
princ_str("\n {object *V",VV[25]);
base[4]= base[3];
(void)simple_symlispcall_no_event(VV[51],base+4,1);
princ_str("=vs_top;object *V",VV[25]);
base[4]= base[2];
(void)simple_symlispcall_no_event(VV[51],base+4,1);
princ_str("=vs_base;",VV[25]);
{object V3;
object V4;
V3= base[1];
V4= car((V3));
T133:;
if(!(endp((V3)))){
goto T134;}
goto T129;
T134:;
bds_bind(VV[21],VV[27]);
base[5]= (V4);
base[6]= base[3];
base[7]= simple_symlispcall_no_event(VV[52],base+5,2);
bds_unwind1;
V3= cdr((V3));
V4= car((V3));
goto T133;}
T129:;
princ_str("\n vs_base=V",VV[25]);
base[4]= base[2];
(void)simple_symlispcall_no_event(VV[51],base+4,1);
princ_str(";vs_top=V",VV[25]);
base[4]= base[3];
(void)simple_symlispcall_no_event(VV[51],base+4,1);
princ_str(";}",VV[25]);
base[4]= VV[28];
symlispcall_no_event(VV[55],base+4,1);
return;
}
/* function definition for C1VALUES */
static L15()
{ register object *base=vs_base;
register object *sup=base+VM7;
vs_reserve(VM7);
check_arg(1);
vs_top=sup;
TTL:;
base[1]= simple_symlispcall_no_event(VV[53],base+2,0);
base[2]= base[0];
base[3]= base[1];
base[0]= simple_symlispcall_no_event(VV[47],base+2,2);
base[2]= list(3,VV[8],base[1],base[0]);
vs_top=(vs_base=base+2)+1;
return;
}
/* function definition for C2VALUES */
static L16()
{ register object *base=vs_base;
register object *sup=base+VM8;
vs_reserve(VM8);
bds_check;
check_arg(1);
vs_top=sup;
TTL:;
base[1]= symbol_value(VV[20]);
bds_bind(VV[20],symbol_value(VV[20]));
if((base[0])!=Cnil){
goto T162;}
princ_str("\n vs_base=vs_top=base+",VV[25]);
base[3]= base[1];
(void)simple_symlispcall_no_event(VV[51],base+3,1);
princ_char(59,VV[25]);
setq(VV[26],Ct);
princ_str("\n vs_base[0]=Cnil;",VV[25]);
goto T160;
T162:;
{object V5;
object V6;
V5= base[0];
V6= car((V5));
T176:;
if(!(endp((V5)))){
goto T177;}
goto T172;
T177:;
base[4]= simple_symlispcall_no_event(VV[56],base+5,0);
base[3]= list(2,VV[29],base[4]);
bds_bind(VV[21],base[3]);
base[4]= (V6);
base[5]= simple_symlispcall_no_event(VV[49],base+4,1);
bds_unwind1;
V5= cdr((V5));
V6= car((V5));
goto T176;}
T172:;
princ_str("\n vs_top=(vs_base=base+",VV[25]);
base[3]= base[1];
(void)simple_symlispcall_no_event(VV[51],base+3,1);
princ_str(")+",VV[25]);
base[3]= number_minus((VV[20]->s.s_dbind),base[1]);
(void)simple_symlispcall_no_event(VV[51],base+3,1);
princ_char(59,VV[25]);
setq(VV[26],Ct);
T160:;
base[3]= VV[28];
symlispcall_no_event(VV[55],base+3,1);
bds_unwind1;
return;
}
/* function definition for C1MULTIPLE-VALUE-SETQ */
static L17()
{ register object *base=vs_base;
register object *sup=base+VM9;
vs_reserve(VM9);
check_arg(1);
vs_top=sup;
TTL:;
base[1]= simple_symlispcall_no_event(VV[53],base+2,0);
base[2]= Cnil;
if(endp(base[0])){
goto T202;}
if(!(endp(cdr(base[0])))){
goto T201;}
T202:;
base[3]= VV[12];
base[4]= VV[30];
base[5]= VV[19];
(void)simple_symlispcall_no_event(VV[43],base+3,3);
T201:;
if(endp(cddr(base[0]))){
goto T209;}
base[3]= VV[12];
base[4]= VV[30];
base[5]= make_fixnum(length(base[0]));
(void)simple_symlispcall_no_event(VV[57],base+3,3);
T209:;
base[3]= car(base[0]);
base[4]= car(base[3]);
T219:;
if(!(endp(base[3]))){
goto T220;}
goto T215;
T220:;
if(type_of(base[4])==t_symbol){
goto T224;}
base[5]= VV[31];
base[6]= base[4];
(void)simple_symlispcall_no_event(VV[58],base+5,2);
T224:;
base[5]= base[4];
vs_top=(vs_base=base+5)+1;
Lconstantp();
vs_top=sup;
if((vs_base[0])==Cnil){
goto T229;}
base[5]= VV[32];
base[6]= base[4];
(void)simple_symlispcall_no_event(VV[58],base+5,2);
T229:;
base[5]= base[4];
base[4]= simple_symlispcall_no_event(VV[59],base+5,1);
base[2]= make_cons(base[4],base[2]);
base[5]= make_cons(car(base[4]),structure_ref(base[1],VV[33],0));
structure_set(base[1],VV[33],0,base[5]);
base[3]= cdr(base[3]);
base[4]= car(base[3]);
goto T219;
T215:;
base[3]= reverse(base[2]);
base[5]= cadr(base[0]);
base[6]= base[1];
base[4]= simple_symlispcall_no_event(VV[54],base+5,2);
base[5]= list(4,VV[12],base[1],base[3],base[4]);
vs_top=(vs_base=base+5)+1;
return;
}
/* function definition for C2MULTIPLE-VALUE-SETQ */
static L18()
{ register object *base=vs_base;
register object *sup=base+VM10;
vs_reserve(VM10);
bds_check;
check_arg(2);
vs_top=sup;
TTL:;
bds_bind(VV[21],VV[22]);
base[3]= base[1];
base[4]= simple_symlispcall_no_event(VV[49],base+3,1);
bds_unwind1;
{object V7;
V7= base[0];
T255:;
if(!(endp((V7)))){
goto T256;}
goto T252;
T256:;
{object V8;
V8= car((V7));
princ_str("\n if(vs_base<vs_top){",VV[25]);
base[2]= VV[28];
base[3]= car((V8));
base[4]= cadr((V8));
(void)simple_symlispcall_no_event(VV[60],base+2,3);
if(endp(cdr((V7)))){
goto T268;}
princ_str("\n vs_base++;",VV[25]);
T268:;
princ_str("\n }else{",VV[25]);
base[2]= Cnil;
base[3]= car((V8));
base[4]= cadr((V8));
(void)simple_symlispcall_no_event(VV[60],base+2,3);
princ_char(125,VV[25]);}
V7= cdr((V7));
goto T255;}
T252:;
if((base[0])!=Cnil){
goto T283;}
princ_str("\n if(vs_base=vs_top){vs_base[0]=Cnil;vs_top=vs_base+1;}",VV[25]);
base[2]= VV[28];
symlispcall_no_event(VV[55],base+2,1);
return;
T283:;
if(symbol_value(VV[34])==VV[35]){
goto T288;}
princ_str("\n ",VV[25]);
(void)simple_symlispcall_no_event(VV[61],base+2,0);
T288:;
base[2]= make_cons(VV[36],car(base[0]));
symlispcall_no_event(VV[55],base+2,1);
return;
}
/* function definition for C1MULTIPLE-VALUE-BIND */
static L19()
{ register object *base=vs_base;
register object *sup=base+VM11;
vs_reserve(VM11);
bds_check;
check_arg(1);
vs_top=sup;
TTL:;
base[1]= simple_symlispcall_no_event(VV[53],base+2,0);
base[2]= Cnil;
base[3]= Cnil;
base[4]= Cnil;
base[5]= Cnil;
base[6]= Cnil;
base[7]= Cnil;
base[8]= Cnil;
base[9]= Cnil;
bds_bind(VV[37],symbol_value(VV[37]));
if(endp(base[0])){
goto T295;}
if(!(endp(cdr(base[0])))){
goto T294;}
T295:;
base[11]= VV[15];
base[12]= VV[30];
base[13]= make_fixnum(length(base[0]));
(void)simple_symlispcall_no_event(VV[43],base+11,3);
T294:;
base[11]= cddr(base[0]);
base[12]= Cnil;
symlispcall_no_event(VV[62],base+11,2);
if(vs_base<vs_top){
base[8]= vs_base[0];
vs_base++;
}else{
base[8]= Cnil;}
if(vs_base<vs_top){
base[5]= vs_base[0];
vs_base++;
}else{
base[5]= Cnil;}
if(vs_base<vs_top){
base[7]= vs_base[0];
vs_base++;
}else{
base[7]= Cnil;}
if(vs_base<vs_top){
base[6]= vs_base[0];
vs_base++;
}else{
base[6]= Cnil;}
if(vs_base<vs_top){
base[9]= vs_base[0];
}else{
base[9]= Cnil;}
vs_top=sup;
base[11]= base[5];
(void)simple_symlispcall_no_event(VV[63],base+11,1);
{object V9;
object V10;
V9= car(base[0]);
V10= car((V9));
T312:;
if(!(endp((V9)))){
goto T313;}
goto T308;
T313:;
base[12]= (V10);
base[13]= base[5];
base[14]= base[6];
base[15]= base[7];
base[11]= simple_symlispcall_no_event(VV[64],base+12,4);
base[3]= make_cons((V10),base[3]);
base[2]= make_cons(base[11],base[2]);
V9= cdr((V9));
V10= car((V9));
goto T312;}
T308:;
base[11]= cadr(base[0]);
base[12]= base[1];
base[4]= simple_symlispcall_no_event(VV[54],base+11,2);
{object V11;
base[11]= reverse(base[2]);
V11= car(base[11]);
T339:;
if(!(endp(base[11]))){
goto T340;}
goto T335;
T340:;
(VV[37]->s.s_dbind)= make_cons((V11),(VV[37]->s.s_dbind));
base[11]= cdr(base[11]);
V11= car(base[11]);
goto T339;}
T335:;
base[11]= base[3];
base[12]= base[7];
base[13]= base[6];
(void)simple_symlispcall_no_event(VV[65],base+11,3);
base[11]= base[9];
base[12]= base[8];
base[8]= simple_symlispcall_no_event(VV[66],base+11,2);
base[11]= base[1];
base[12]= cadr(base[8]);
(void)simple_symlispcall_no_event(VV[67],base+11,2);
structure_set(base[1],VV[33],2,structure_ref(cadr(base[8]),VV[33],2));
{object V12;
object V13;
V12= base[2];
V13= car((V12));
T367:;
if(!(endp((V12)))){
goto T368;}
goto T363;
T368:;
base[11]= (V13);
(void)simple_symlispcall_no_event(VV[68],base+11,1);
V12= cdr((V12));
V13= car((V12));
goto T367;}
T363:;
base[11]= reverse(base[2]);
base[12]= list(5,VV[15],base[1],base[11],base[4],base[8]);
vs_top=(vs_base=base+12)+1;
bds_unwind1;
return;
}
/* function definition for C2MULTIPLE-VALUE-BIND */
static L20()
{ register object *base=vs_base;
register object *sup=base+VM12;
vs_reserve(VM12);
bds_check;
check_arg(3);
vs_top=sup;
TTL:;
{object V14;
V14= Cnil;
base[3]= Cnil;
bds_bind(VV[38],symbol_value(VV[38]));
bds_bind(VV[20],symbol_value(VV[20]));
bds_bind(VV[39],symbol_value(VV[39]));
bds_bind(VV[40],symbol_value(VV[40]));
{object V15;
object V16;
V15= base[0];
V16= car((V15));
T384:;
if(!(endp((V15)))){
goto T385;}
goto T380;
T385:;
{object V17;
base[8]= (V16);
V17= simple_symlispcall_no_event(VV[69],base+8,1);
if(((V17))==Cnil){
goto T393;}
setq(VV[24],number_plus(symbol_value(VV[24]),VV[18]));
base[8]= symbol_value(VV[24]);
structure_set((V16),VV[36],1,(V17));
structure_set((V16),VV[36],4,base[8]);
princ_str("\n ",VV[25]);
if(((V14))!=Cnil){
goto T400;}
princ_char(123,VV[25]);
V14= Ct;
T400:;
base[9]=symbol_function(VV[51]);
base[11]= (V17);
base[10]= simple_symlispcall_no_event(VV[70],base+11,1);
(void)simple_lispcall_no_event(base+9,1);
princ_char(86,VV[25]);
base[9]= base[8];
(void)simple_symlispcall_no_event(VV[51],base+9,1);
princ_char(59,VV[25]);
goto T389;
T393:;
base[8]= simple_symlispcall_no_event(VV[56],base+9,0);
structure_set((V16),VV[36],2,base[8]);}
T389:;
V15= cdr((V15));
V16= car((V15));
goto T384;}
T380:;
bds_bind(VV[21],VV[22]);
base[9]= base[1];
base[10]= simple_symlispcall_no_event(VV[49],base+9,1);
bds_unwind1;
bds_bind(VV[39],(VV[39]->s.s_dbind));
bds_bind(VV[38],(VV[38]->s.s_dbind));
bds_bind(VV[40],(VV[40]->s.s_dbind));
{object V18;
V18= base[0];
T424:;
if(!(endp((V18)))){
goto T425;}
bds_unwind1;
bds_unwind1;
bds_unwind1;
goto T421;
T425:;
setq(VV[41],number_plus(symbol_value(VV[41]),VV[18]));
base[11]= make_cons(symbol_value(VV[41]),Cnil);
base[3]= make_cons(base[11],base[3]);
princ_str("\n if(vs_base>=vs_top){",VV[25]);
(void)simple_symlispcall_no_event(VV[61],base+11,0);
if(type_of(car(base[3]))!=t_cons)FEwrong_type_argument(Scons,car(base[3]));
(car(base[3]))->c.c_cdr = Ct;
princ_str("goto T",VV[25]);
base[11]= car(car(base[3]));
(void)simple_symlispcall_no_event(VV[51],base+11,1);
princ_char(59,VV[25]);
princ_char(125,VV[25]);
base[11]= car((V18));
base[12]= VV[42];
(void)simple_symlispcall_no_event(VV[71],base+11,2);
if(endp(cdr((V18)))){
goto T446;}
princ_str("\n vs_base++;",VV[25]);
T446:;
V18= cdr((V18));
goto T424;}
T421:;
princ_str("\n ",VV[25]);
(void)simple_symlispcall_no_event(VV[61],base+8,0);
setq(VV[41],number_plus(symbol_value(VV[41]),VV[18]));
base[8]= make_cons(symbol_value(VV[41]),Cnil);
princ_str("\n ",VV[25]);
if(type_of(base[8])!=t_cons)FEwrong_type_argument(Scons,base[8]);
(base[8])->c.c_cdr = Ct;
princ_str("goto T",VV[25]);
base[9]= car(base[8]);
(void)simple_symlispcall_no_event(VV[51],base+9,1);
princ_char(59,VV[25]);
base[3]= reverse(base[3]);
{object V19;
object V20;
V19= base[0];
V20= car((V19));
T471:;
if(!(endp((V19)))){
goto T472;}
goto T467;
T472:;
if((cdr(car(base[3])))==Cnil){
goto T476;}
princ_str("\nT",VV[25]);
base[9]= car(car(base[3]));
(void)simple_symlispcall_no_event(VV[51],base+9,1);
princ_str(":;",VV[25]);
T476:;
base[9]= car(base[3]);
base[3]= cdr(base[3]);
base[9]= (V20);
base[10]= Cnil;
(void)simple_symlispcall_no_event(VV[71],base+9,2);
V19= cdr((V19));
V20= car((V19));
goto T471;}
T467:;
if((cdr(base[8]))==Cnil){
goto T455;}
princ_str("\nT",VV[25]);
base[9]= car(base[8]);
(void)simple_symlispcall_no_event(VV[51],base+9,1);
princ_str(":;",VV[25]);
T455:;
base[8]= base[2];
(void)simple_symlispcall_no_event(VV[72],base+8,1);
if(((V14))==Cnil){
goto T504;}
princ_char(125,VV[25]);
base[8]= Cnil;
vs_top=(vs_base=base+8)+1;
bds_unwind1;
bds_unwind1;
bds_unwind1;
bds_unwind1;
return;
T504:;
base[8]= Cnil;
vs_top=(vs_base=base+8)+1;
bds_unwind1;
bds_unwind1;
bds_unwind1;
bds_unwind1;
return;}
}